home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1993 / MacHack 1993.toast / MacHack™ 1987-1992 / MacHack™ '87 / Source ƒ / XLISP ƒ / XLISP 1.7 C SRCS / macfun.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-05-09  |  7.2 KB  |  376 lines  |  [TEXT/EDIT]
  1. /* macfun.c - macintosh user interface functions for xlisp */
  2.  
  3. #include "xlisp.h"
  4. #include <mem.h>
  5. #include <qd.h>
  6.  
  7. overlay "macstuff"
  8.  
  9. /* external variables */
  10. extern NODE ***xlstack;
  11. extern GrafPtr cwindow,gwindow;
  12.  
  13. /* forward declarations */
  14. FORWARD NODE *do_0();
  15. FORWARD NODE *do_1();
  16. FORWARD NODE *do_2();
  17.  
  18. /* pow - fake power function */
  19. pow()
  20. {
  21.     xlfail("function not available");
  22. }
  23.  
  24. /* xhidepen - hide the pen */
  25. NODE *xhidepen(args)
  26.   NODE *args;
  27. {
  28.     return (do_0(args,'H'));
  29. }
  30.  
  31. /* xshowpen - show the pen */
  32. NODE *xshowpen(args)
  33.   NODE *args;
  34. {
  35.     return (do_0(args,'S'));
  36. }
  37.  
  38. /* xgetpen - get the pen position */
  39. NODE *xgetpen(args)
  40.   NODE *args;
  41. {
  42.     NODE ***oldstk,*val;
  43.     Point p;
  44.     xllastarg(args);
  45.     SetPort(gwindow);
  46.     GetPen(&p);
  47.     SetPort(cwindow);
  48.     oldstk = xlstack;
  49.     xlsave1(val);
  50.     val = consa(NIL);
  51.     rplaca(val,cvfixnum((FIXNUM)p.a.h));
  52.     rplacd(val,cvfixnum((FIXNUM)p.a.v));
  53.     xlstack = oldstk;
  54.     return (val);
  55. }
  56.  
  57. /* xpenmode - set the pen mode */
  58. NODE *xpenmode(args)
  59.   NODE *args;
  60. {
  61.     return (do_1(args,'M'));
  62. }
  63.  
  64. /* xpensize - set the pen size */
  65. NODE *xpensize(args)
  66.   NODE *args;
  67. {
  68.     return (do_2(args,'S'));
  69. }
  70.  
  71. /* xpenpat - set the pen pattern */
  72. NODE *xpenpat(args)
  73.   NODE *args;
  74. {
  75.     NODE *plist;
  76.     char pat[8],i;
  77.     plist = xlmatch(LIST,&args);
  78.     xllastarg(args);
  79.     for (i = 0; i < 8 && consp(plist); ++i, plist = cdr(plist))
  80.     if (fixp(car(plist)))
  81.         pat[i] = car(plist)->n_int;
  82.     SetPort(gwindow);
  83.     PenPat(pat);
  84.     SetPort(cwindow);
  85.     return (NIL);
  86. }
  87.  
  88. /* xpennormal - set the pen to normal */
  89. NODE *xpennormal(args)
  90.   NODE *args;
  91. {
  92.     xllastarg(args);
  93.     SetPort(gwindow);
  94.     PenNormal();
  95.     SetPort(cwindow);
  96.     return (NIL);
  97. }
  98.  
  99. /* xmoveto - Move to a screen location */
  100. NODE *xmoveto(args)
  101.   NODE *args;
  102. {
  103.     return (do_2(args,'m'));
  104. }
  105.  
  106. /* xmove - Move in a specified direction */
  107. NODE *xmove(args)
  108.   NODE *args;
  109. {
  110.     return (do_2(args,'M'));
  111. }
  112.  
  113. /* xlineto - draw a Line to a screen location */
  114. NODE *xlineto(args)
  115.   NODE *args;
  116. {
  117.     return (do_2(args,'l'));
  118. }
  119.  
  120. /* xline - draw a Line in a specified direction */
  121. NODE *xline(args)
  122.   NODE *args;
  123. {
  124.     return (do_2(args,'L'));
  125. }
  126.  
  127. /* xshowgraphics - show the graphics window */
  128. NODE *xshowgraphics(args)
  129.   NODE *args;
  130. {
  131.     xllastarg(args);
  132.     scrsplit(1);
  133.     return (NIL);
  134. }
  135.  
  136. /* xhidegraphics - hide the graphics window */
  137. NODE *xhidegraphics(args)
  138.   NODE *args;
  139. {
  140.     xllastarg(args);
  141.     scrsplit(0);
  142.     return (NIL);
  143. }
  144.  
  145. /* xcleargraphics - clear the graphics window */
  146. NODE *xcleargraphics(args)
  147.   NODE *args;
  148. {
  149.     xllastarg(args);
  150.     SetPort(gwindow);
  151.     EraseRect(&gwindow->portRect);
  152.     SetPort(cwindow);
  153.     return (NIL);
  154. }
  155.  
  156. /* do_0 - Handle commands that require no arguments */
  157. LOCAL NODE *do_0(args,fcn)
  158.   NODE *args; int fcn;
  159. {
  160.     xllastarg(args);
  161.     SetPort(gwindow);
  162.     switch (fcn) {
  163.     case 'H':    HidePen(); break;
  164.     case 'S':    ShowPen(); break;
  165.     }
  166.     SetPort(cwindow);
  167.     return (NIL);
  168. }
  169.  
  170. /* do_1 - Handle commands that require one integer argument */
  171. LOCAL NODE *do_1(args,fcn)
  172.   NODE *args; int fcn;
  173. {
  174.     int x;
  175.     x = getnumber(&args);
  176.     xllastarg(args);
  177.     SetPort(gwindow);
  178.     switch (fcn) {
  179.     case 'M':    PenMode(x); break;
  180.     }
  181.     SetPort(cwindow);
  182.     return (NIL);
  183. }
  184.  
  185. /* do_2 - Handle commands that require two integer arguments */
  186. LOCAL NODE *do_2(args,fcn)
  187.   NODE *args; int fcn;
  188. {
  189.     int h,v;
  190.     h = getnumber(&args);
  191.     v = getnumber(&args);
  192.     xllastarg(args);
  193.     SetPort(gwindow);
  194.     switch (fcn) {
  195.     case 'l':    LineTo(h,v); break;
  196.     case 'L':    Line(h,v);   break;
  197.     case 'm':   MoveTo(h,v); break;
  198.     case 'M':    Move(h,v);   break;
  199.     case 'S':    PenSize(h,v);break;
  200.     }
  201.     SetPort(cwindow);
  202.     return (NIL);
  203. }
  204.  
  205. /* getnumber - get an integer parameter */
  206. LOCAL int getnumber(pargs)
  207.   NODE **pargs;
  208. {
  209.     return ((int)xlmatch(INT,pargs)->n_int);
  210. }
  211.  
  212. /* xtool - call the toolbox */
  213. NODE *xtool(args)
  214.   NODE *args;
  215. {
  216.     NODE *val;
  217.     int trap;
  218.  
  219.     trap = (int)xlmatch(INT,&args)->n_int;
  220.  
  221.     asm {
  222.     move.l    args(A6),D0
  223.     beq    L2
  224. L1:    move.l    D0,A0
  225.     move.l    2(A0),A1
  226.     move.w    4(A1),-(A7)
  227.     move.l    6(A0),D0
  228.     bne    L1
  229. L2:    lea    L3,A0
  230.     move.w    trap(A6),(A0)
  231. L3:    dc.w    0xA000
  232.     clr.l    val(A6)
  233.     }
  234.  
  235.     return (val);
  236. }
  237.  
  238. /* xtool16 - call the toolbox with a 16 bit result */
  239. NODE *xtool16(args)
  240.   NODE *args;
  241. {
  242.     int trap,val;
  243.  
  244.     trap = xlmatch(INT,&args)->n_int;
  245.  
  246.     asm {
  247.     clr.w    -(A7)
  248.     move.l    args(A6),D0
  249.     beq    L2
  250. L1:    move.l    D0,A0
  251.     move.l    2(A0),A1
  252.     move.w    4(A1),-(A7)
  253.     move.l    6(A0),D0
  254.     bne    L1
  255. L2:    lea    L3,A0
  256.     move.w    trap(A6),(A0)
  257. L3:    dc.w    0xA000
  258.     move.w    (A7)+,val(A6)
  259.     }
  260.  
  261.     return (cvfixnum((FIXNUM)val));
  262. }
  263.  
  264. /* xtool32 - call the toolbox with a 32 bit result */
  265. NODE *xtool32(args)
  266.   NODE *args;
  267. {
  268.     int trap;
  269.     long val;
  270.  
  271.     trap = xlmatch(INT,&args)->n_int;
  272.  
  273.     asm {
  274.     clr.l    -(A7)
  275.     move.l    args(A6),D0
  276.     beq    L2
  277. L1:    move.l    D0,A0
  278.     move.l    2(A0),A1
  279.     move.w    4(A1),-(A7)
  280.     move.l    6(A0),D0
  281.     bne    L1
  282. L2:    lea    L3,A0
  283.     move.w    trap(A6),(A0)
  284. L3:    dc.w    0xA000
  285.     move.l    (A7)+,val(A6)
  286.     }
  287.  
  288.     return (cvfixnum((FIXNUM)val));
  289. }
  290.  
  291. /* xnewhandle - allocate a new handle */
  292. NODE *xnewhandle(args)
  293.   NODE *args;
  294. {
  295.     long size;
  296.     size = (long)xlmatch(INT,&args)->n_int;
  297.     xllastarg(args);
  298.     return (cvfixnum((FIXNUM)NewHandle(size)));
  299. }
  300.  
  301. /* xnewptr - allocate memory */
  302. NODE *xnewptr(args)
  303.   NODE *args;
  304. {
  305.     long size;
  306.     size = (long)xlmatch(INT,&args)->n_int;
  307.     xllastarg(args);
  308.     return (cvfixnum((FIXNUM)NewPtr(size)));
  309. }
  310.     
  311. /* xhiword - return the high order 16 bits of an integer */
  312. NODE *xhiword(args)
  313.   NODE *args;
  314. {
  315.     unsigned int val;
  316.     val = (unsigned int)(xlmatch(INT,&args)->n_int >> 16);
  317.     xllastarg(args);
  318.     return (cvfixnum((FIXNUM)val));
  319. }
  320.  
  321. /* xloword - return the low order 16 bits of an integer */
  322. NODE *xloword(args)
  323.   NODE *args;
  324. {
  325.     unsigned int val;
  326.     val = (unsigned int)xlmatch(INT,&args)->n_int;
  327.     xllastarg(args);
  328.     return (cvfixnum((FIXNUM)val));
  329. }
  330.  
  331. /* xrdnohang - get the next character in the look-ahead buffer */
  332. NODE *xrdnohang(args)
  333.   NODE *args;
  334. {
  335.     int ch;
  336.     xllastarg(args);
  337.     if ((ch = scrnextc()) == EOF)
  338.     return (NIL);
  339.     return (cvfixnum((FIXNUM)ch));
  340. }
  341.  
  342. /* osfinit - initialize the macintosh functions */
  343. osfinit()
  344. {
  345.     NODE *sym;
  346.  
  347.     xlsubr("HIDEPEN",        SUBR,    xhidepen);
  348.     xlsubr("SHOWPEN",        SUBR,    xshowpen);
  349.     xlsubr("GETPEN",        SUBR,    xgetpen);
  350.     xlsubr("PENSIZE",        SUBR,    xpensize);
  351.     xlsubr("PENMODE",        SUBR,    xpenmode);
  352.     xlsubr("PENPAT",        SUBR,    xpenpat);
  353.     xlsubr("PENNORMAL",        SUBR,    xpennormal);
  354.     xlsubr("MOVETO",        SUBR,    xmoveto);
  355.     xlsubr("MOVE",        SUBR,    xmove);
  356.     xlsubr("LINETO",        SUBR,    xlineto);
  357.     xlsubr("LINE",        SUBR,    xline);
  358.     xlsubr("SHOW-GRAPHICS",    SUBR,    xshowgraphics);
  359.     xlsubr("HIDE-GRAPHICS",    SUBR,    xhidegraphics);
  360.     xlsubr("CLEAR-GRAPHICS",    SUBR,    xcleargraphics);
  361.     xlsubr("TOOLBOX",        SUBR,    xtool);
  362.     xlsubr("TOOLBOX-16",    SUBR,    xtool16);
  363.     xlsubr("TOOLBOX-32",    SUBR,    xtool32);
  364.     xlsubr("NEWHANDLE",        SUBR,    xnewhandle);
  365.     xlsubr("NEWPTR",        SUBR,    xnewptr);
  366.     xlsubr("HIWORD",        SUBR,    xhiword);
  367.     xlsubr("LOWORD",        SUBR,    xloword);
  368.     xlsubr("READ-CHAR-NO-HANG",    SUBR,    xrdnohang);
  369.  
  370.     /* setup globals for the window handles */
  371.     sym = xlsenter("*COMMAND-WINDOW*");
  372.     sym->n_symvalue = cvfixnum((FIXNUM)cwindow);
  373.     sym = xlsenter("*GRAPHICS-WINDOW*");
  374.     sym->n_symvalue = cvfixnum((FIXNUM)gwindow);
  375. }
  376.